home *** CD-ROM | disk | FTP | other *** search
/ An Introduction to Progr…l Basic 6.0 (4th Edition) / An Introduction to Programming using Visual Basic 6.0.iso / COMMON / TOOLS / VB / UNSUPPRT / DANIM / SAMPLES / DA / VISUALBASIC / SHOWCASE / PICK3 / PICK3.FRM (.txt) < prev    next >
Encoding:
Visual Basic Form  |  1998-03-12  |  6.1 KB  |  135 lines
  1. VERSION 5.00
  2. Object = "{34F681D0-3640-11CF-9294-00AA00B8A733}#1.0#0"; "danim.dll"
  3. Begin VB.Form Picking 
  4.    BorderStyle     =   1  'Fixed Single
  5.    Caption         =   "Picking"
  6.    ClientHeight    =   4665
  7.    ClientLeft      =   30
  8.    ClientTop       =   270
  9.    ClientWidth     =   5055
  10.    LinkTopic       =   "Form1"
  11.    MaxButton       =   0   'False
  12.    MinButton       =   0   'False
  13.    ScaleHeight     =   4665
  14.    ScaleWidth      =   5055
  15.    StartUpPosition =   3  'Windows Default
  16.    Begin DirectAnimationCtl.DAViewerControlWindowed DAViewerControlWindowed 
  17.       Height          =   4455
  18.       Left            =   120
  19.       OleObjectBlob   =   "Pick3.frx":0000
  20.       TabIndex        =   0
  21.       Top             =   120
  22.       Width           =   4815
  23.    End
  24. Attribute VB_Name = "Picking"
  25. Attribute VB_GlobalNameSpace = False
  26. Attribute VB_Creatable = False
  27. Attribute VB_PredeclaredId = True
  28. Attribute VB_Exposed = False
  29. 'Pick3 Visual Basic Sample
  30. Private Sub Form_Load()
  31.   pi = 3.1459
  32.   Dim size As DATransform3
  33.   Set size = Scale3Uniform(0.25)
  34.   Dim speed As DANumber
  35.   Set speed = DANumber(0.07)
  36.   ' Set up relative paths for media imports.  Does not work in VB
  37.   ' debug.  Create executable.
  38.   Dim mediaBase, geoBase, imgBase As String
  39.   mediaBase = CurDir + "\..\..\..\..\..\Media\"
  40.   geoBase = mediaBase + "geometry\"
  41.   imgBase = mediaBase + "image\"
  42.   'Import the geometries.
  43.   Dim rawCube As DAGeometry
  44.   Set rawCube = ImportGeometry(geoBase + "cube.x").Transform(size)
  45.   Dim rawCylinder As DAGeometry
  46.   Set rawCylinder = ImportGeometry(geoBase + "cylinder.x").Transform(size)
  47.   Dim rawCone As DAGeometry
  48.   Set rawCone = ImportGeometry(geoBase + "cone.x").Transform(size)
  49.   'Import background.
  50.   Dim stillSky As DAImage
  51.   Set stillSky = ImportImage(imgBase + "cldtile.jpg")
  52.   'Make the geometries pickable.
  53.   Set cone1 = activate(rawCone, Green)
  54.   Set cube1 = activate(rawCube, Magenta)
  55.   Set cube2 = activate(rawCube, ColorHslAnim(Div(LocalTime, DANumber(8)), DANumber(1), DANumber(0.5)))
  56.   Set cylinder = activate(rawCylinder, ColorRgb(0.8, 0.4, 0.4))
  57.   'Construct the final geometry, scale and rotate it.
  58.   Set multigeo = UnionGeometry(cone1.Transform(Translate3(0, 1, 0)), _
  59.     UnionGeometry(cube1.Transform(Translate3(0, 0, 1)), _
  60.     UnionGeometry(cube2.Transform(Translate3(0, 0, -1)), cylinder)))
  61.   Set X = Add(DAStatics.Abs(DAStatics.Sin(Mul(LocalTime, _
  62.     DANumber(0.2)))), DANumber(0.5))
  63.   Set Y = Add(DAStatics.Abs(DAStatics.Sin(Mul(LocalTime, _
  64.     DANumber(0.26)))), DANumber(0.5))
  65.   Set Z = Add(DAStatics.Abs(DAStatics.Sin(Mul(LocalTime, _
  66.     DANumber(0.14)))), DANumber(0.5))
  67.      
  68.   Set geo = multigeo.Transform(Scale3Anim(X, Y, Z))
  69.   Set maxSky = stillSky.BoundingBox().Max()
  70.   Set tiledSky = stillSky.Tile()
  71.   Set movingSky = tiledSky.Transform(Translate2Anim(Mul(LocalTime, _
  72.     Div(maxSky.X, DANumber(8))), Mul(LocalTime, Div(maxSky.X, DANumber(16)))))
  73.   Set movingGeoImg = geometryImage(geo.Transform(Compose3(Rotate3Anim(ZVector3, _
  74.     Mul(speed, Mul(LocalTime(), DANumber(1.9)))), _
  75.       Rotate3Anim(YVector3, Mul(speed, Mul(LocalTime(), DANumber(pi)))))), speed)
  76.   Set fs = DefaultFont.size(14).Color(Black)
  77.   Set titleIm = StringImage("Left Click on an Object", fs).Transform(Translate2(0, 0.04))
  78.   DAViewerControlWindowed.UpdateInterval = 0.2
  79.   'Display the final image.
  80.   DAViewerControlWindowed.Image = Overlay(titleIm, Overlay(movingGeoImg, movingSky))
  81.   'Start the animation.
  82.   DAViewerControlWindowed.Start
  83. End Sub
  84. Function activate(unpickedGeo As DAGeometry, col As DAColor) As DAGeometry
  85.   Dim pickGeo As DAPickableResult
  86.   Set pickGeo = unpickedGeo.Pickable()
  87.   Dim pickEvent As DAEvent
  88.   Set pickEvent = AndEvent(LeftButtonDown, pickGeo.pickEvent)
  89.   Dim numcyc As DANumber
  90.   Set numcyc = CreateObject("DirectAnimation.DANumber")
  91.   numcyc.Init DAStatics.Until(DANumber(0), pickEvent, DAStatics.Until(DANumber(1), pickEvent, numcyc))
  92.   Dim colcyc As DAColor
  93.   Set colcyc = CreateObject("DirectAnimation.DAColor")
  94.   colcyc.Init DAStatics.Until(White, pickEvent, DAStatics.Until(col, pickEvent, colcyc))
  95.   Dim xf As DATransform3
  96.   Set xf = Rotate3Anim(XVector3, Integral(numcyc))
  97.   Set activate = pickGeo.Geometry.DiffuseColor(colcyc).Transform(xf)
  98. End Function
  99. Function geometryImage(geo As DAGeometry, speed As DANumber) As DAImage
  100.   Dim scaleFactor As DANumber
  101.   Set scaleFactor = DANumber(0.02)
  102.   Dim perspTransform As DATransform3
  103.   Set perspTransform = CreateObject("DirectAnimation.DATransform3")
  104.     perspTransform.Init DAStatics.Until(Compose3(Rotate3Anim(XVector3, _
  105.       Mul(speed, LocalTime)), Translate3(0, 0, 0.2)), RightButtonDown, _
  106.         DAStatics.Until(Rotate3Anim(XVector3, Mul(speed, LocalTime)), _
  107.           RightButtonDown, perspTransform))
  108.   Set light = UnionGeometry(DirectionalLight.Transform(perspTransform), _
  109.     DirectionalLight)
  110.   Dim strcyl As DAString
  111.   Set strcyl = CreateObject("DirectAnimation.DAString")
  112.   strcyl.Init DAStatics.Until(DAString("Perspective - Right Click to Switch"), _
  113.     RightButtonDown, DAStatics.Until(DAString("Parallel - Right Click to Switch"), _
  114.       RightButtonDown, strcyl))
  115.       
  116.   Dim perspectiveCam As DACamera
  117.   Set perspectiveCam = PerspectiveCamera(1, 0).Transform(Compose3(Rotate3Anim(XVector3, _
  118.     Mul(speed, LocalTime)), Translate3(0, 0, 0.2)))
  119.   Dim parallelCam As DACamera
  120.   Set parallelCam = ParallelCamera(1).Transform(Rotate3Anim(XVector3, _
  121.     Mul(speed, LocalTime)))
  122.   Dim camera As DACamera
  123.   Set camera = CreateObject("DirectAnimation.DACamera")
  124.   camera.Init DAStatics.Until(perspectiveCam, RightButtonDown, _
  125.     DAStatics.Until(parallelCam, RightButtonDown, camera))
  126.   Dim fs As DAFontStyle
  127.   Set fs = DefaultFont.size(14).Color(Red)
  128.   Dim txtIm, xltTxt As DAImage
  129.   Set txtIm = StringImageAnim(strcyl, fs)
  130.   Set xltTxt = txtIm.Transform(Translate2(0, -0.045))
  131.   Set geometryImg = UnionGeometry(geo.Transform(Scale3UniformAnim(scaleFactor)), _
  132.     light).Render(camera)
  133.   Set geometryImage = Overlay(xltTxt, geometryImg)
  134. End Function
  135.